(defun* first (c) (car c))
(defun* second (c) (car (cdr c)))
(defun* third (c) (car (cdr (cdr c))))
(defun* forth (c) (car (cdr (cdr (cdr c)))))

(defun* atom (s) (not (consp s)))
(defun* null (s) (not s))

; (DEFUN name (args...) body...) -> name
(defmacro* defun (name args &rest body)
  `(defun* ,name ,args
     (block ,name
	,@body)))

(defun integer-string-from-buffer (b i n)
  (if (eq n 0) 0
      (let ((c (integer-string-from-buffer b i (/ n 10))))
	(selt b c (code-char (* (char-code #\0) (% n 10))))
	(+ c 1))))

; (INTEGER-STRING n) -> string
(defun integer-string (n)
  (if (integerp n)
      (let ((b (make-buffer 8)))
	(integer-string-from-buffer b 0 n)
	b)))

(defun replace* (seq1 seq2 pos1 pos2 len)
  (let ((i 0))
    (while*
     (if (not (< i len))
	 (return-from replace* seq1))
     (selt seq1 (+ pos1 i) (elt seq2 (+ pos2 i)))
     (setq i (+ i 1)))))

(defun concatenate (stg1 stg2)
  (let ((stg3 (make-buffer (+ (length stg1) (length stg2) 1))))
    (replace* stg3 stg1 0 0 (length stg1))
    (replace* stg3 stg2 (length stg1) 0 (length stg2))
    stg3))

(setq *gensym-counter* 0)
(defun gensym ()
  (setq *gensym-counter* (+ 1 *gensym-counter*))
  (make-symbol (concatenate "#:G" (integer-string (- *gensym-counter* 1)))))

(defmacro* and (a &rest rest)
  (if rest
      `(if ,a (and ,@rest) nil)
    a))

(defmacro* or (a &rest rest)
  (if rest
      (let ((b (gensym)))
	`(let ((,b ,a))
	   (if ,b ,b (or ,@rest))))
    a))

(defmacro* multiple-value-list (form)
  `(multiple-value-call #'list ,form))

; (MAPCARCAR (list1 list2...)) -> ((car list1) (car list2)...); ((cdr list1) (cdr list2)...)
(defun mapcarcar (ls)
  (if (consp ls)
      (if (consp (car ls))
	  (let* ((tmp (multiple-value-list (mapcarcar (cdr ls))))
		 (a (first tmp)) (b (second tmp)))
	    (if (eq 1 (length tmp)) (return-from mapcarcar nil))
	    (values (cons (car (car ls)) a)
		    (cons (cdr (car ls)) b)))
	nil)
    (values nil nil)))

(defun mapcar (fn ls &rest rest)
  (let ((tmp (multiple-value-list (mapcarcar rest))))
    (if (eq 1 (length tmp))
	(return-from mapcar nil))
    (if (consp ls)
	(cons (apply fn (car ls) (car tmp))
	      (apply #'mapcar fn (cdr ls) (second tmp)))
      nil)))

(defmacro* return (&optional form)
  `(return-from nil ,form))

(defmacro* do (a b &rest body)
  `(block nil
     (let ,(mapcar (lambda (l) (subseq l 0 2)) a)
       (while* (if ,(first b) (return ,(second b)))
	       ,@body
	       ,@(mapcar (lambda (l) `(setq ,(first l) ,(third l))) a)))))

(defmacro* do* (a b &rest body)
  `(block nil
     (let* ,(mapcar (lambda (l) (subseq l 0 2)) a)
       (while* (if ,(first b) (return ,(second b)))
	       ,@body
	       ,@(mapcar (lambda (l) `(setq ,(first l) ,(third l))) a)))))

(defmacro* dotimes (a &rest body)
  `(do ((,(car a) 0 (+ 1 ,(car a))))
       ((> ,(car a) (- ,(second a) 1)) ,(third a))
     ,@body))

(defmacro* dolist (a &rest body)
  (let ((g (gensym)))
    `(do ((,g ,(second a) (cdr ,g))
	  (,(first a)))
	 ((not ,g) ,(third a))
       (setq ,(first a) (car ,g))
       ,@body)))

(setq newline (code-char 10))

(defun* write-line (str &optional (s nil))
  (dotimes (i (length str))
    (if s (write-char (elt str i) s)
      (write-char (elt str i))))
  (if s (write-char newline s)
    (write-char newline))
  t)

(defmacro* with-open-file (spec &rest body)
  `(let ((,(car spec) (open* ,(second spec))))
     ,@body
     (close* ,(car spec))))

(defmacro* == (&rest args)
  `(eq ,@args))

(defun = (&rest rest)
  (apply #'eq rest))

(defun fibeq (n)
  (if (eq n 0) 0
    (if (eq n 1) 1
      (+ (fibeq (- n 1)) (fibeq (- n 2))))))

(defun fibapply (n)
  (if (= n 0) 0
    (if (= n 1) 1
      (+ (fibapply (- n 1)) (fibapply (- n 2))))))

(defun fibmacro (n)
  (if (== n 0) 0
    (if (== n 1) 1
      (+ (fibmacro (- n 1)) (fibmacro (- n 2))))))

(defun maphash (fn tab)
  (dolist (key (hash-table-keys tab))
    (apply fn key (gethash key tab) nil)))

(defun max (a &rest rest)
  (if rest
      (let ((tmp (apply #'max rest)))
	(if (> a tmp) a tmp))
    a))

(defun min (a &rest rest)
  (if rest
      (let ((tmp (apply #'max rest)))
	(if (< a tmp) a tmp))
    a))

(defmacro* multiple-value-setq (vars form)
  (let ((rest (gensym)))
    `(multiple-value-call
      (lambda (&rest ,rest)
	,@(let ((i (- 1)))
	    (mapcar (lambda (v) (setq i (+ i 1)) `(setq ,v (nth ,rest ,i))) vars))
	(car ,rest))
      ,form)))

(defmacro* unless (a &rest body)
  `(if (not ,a) (progn ,@body)))

(defmacro* when (a &rest body)
  `(if ,a ,(if (> (length body) 1) `(progn ,@body)
	       (car body))))

(defmacro* cond (l &rest rest)
  `(if ,(car l)
       ,(if (eq (length (cdr l)) 1) (second l) `(progn ,@(cdr l)))
       ,(if rest `(cond ,@rest))))

(defun fibcond (n)
  (cond
    ((eq n 0) 0)
    ((eq n 1) 1)
    (t (+ (fibcond (- n 1))
	  (fibcond (- n 2))))))

(defun reverse (lst)
  (if lst
      (let ((r (cons (car lst) nil)))
	(dolist (a (cdr lst) r)
	  (setq r (cons a r))))))

(defun append* (lis last)
  (if lis
      (cons (car lis) (append* (cdr lis) last))
      last))

(defun append (lst &rest rest)
  (append* lst (if rest (apply #'append rest))))

(defun list* (a &rest rest)
  (if rest
      (cons a (apply #'list* rest))
      a))

(defun listp (s) (or (not s) (consp s)))

(defun make-list (size &key initial-element)
  (when (> size 0)
    (cons initial-element (make-list (- size 1) :initial-element initial-element))))

(defun last (lst &optional (n 1))
  (do ((a lst (cdr a)))
      ((not (consp (nthcdr a n))) a)))

(defun acons (key data alis)
  (cons (cons key data) alis))

(defun assoc (key alis)
  (dolist (i alis)
    (when (eq key (car i))
      (return i))))

(defun pairlis (keys data &optional alis)
  (when keys
    (acons (car keys) (car data)
	   (pairlis (cdr keys) (cdr data) alis))))

